home *** CD-ROM | disk | FTP | other *** search
/ CAD Tools / CAD Tools.iso / programs / cad010.exe / ACADWIN3.EXE / SAMPLE / DELLAYER.LSP < prev    next >
Lisp/Scheme  |  1994-03-08  |  5KB  |  130 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;;   DELLAYER.lsp
  3. ;;;   Copyright (C) 1990 - 1994 by Autodesk, Inc.
  4. ;;;
  5. ;;;   Permission to use, copy, modify, and distribute this software
  6. ;;;   for any purpose and without fee is hereby granted, provided
  7. ;;;   that the above copyright notice appears in all copies and that
  8. ;;;   both that copyright notice and this permission notice appear in
  9. ;;;   all supporting documentation.
  10. ;;;
  11. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  12. ;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  13. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  14. ;;;
  15. ;;;   Version 2.0
  16. ;;; --------------------------------------------------------------------------;
  17. ;;;   DESCRIPTION
  18. ;;;
  19. ;;;   This program deletes all entities on specified layers.  Wildcards
  20. ;;;   can be specified.
  21. ;;;
  22. ;;;   Version 2.0 has been updated to delete entities in both paper
  23. ;;;   space and modelspace. An additional prompt has been added to
  24. ;;;   prepare a layer for purging. If desired, the layer(s) will be
  25. ;;;   thawed and turned off, to make purging possible.
  26. ;;;   Script files using earlier versions of this routine must be
  27. ;;;   updated to accomodate the extra prompt.
  28. ;;;
  29. ;;; --------------------------------------------------------------------------;
  30.  
  31. (defun dellerr (s)                    ; If an error (such as CTRL-C) occurs
  32.                                       ; while this command is active...
  33.   (if (/= s "Function cancelled")
  34.     (princ (strcat "\nError: " s))
  35.   )
  36.   (setq sset_1 nil)                   ; Free selection-sets if any
  37.   (setq sset_2 nil)
  38.   (setvar "CMDECHO" ocmd)             ; Restore saved mode
  39.   (setq *error* olderr)               ; Restore old *error* handler
  40.   (princ)
  41. )
  42.  
  43.  
  44. (defun c:DELLAYER ( / sset_1 sset_2 prg num count ex)
  45.    (setq olderr *error*
  46.         *error* dellerr)
  47.  
  48.    (setq ocmd (getvar "CMDECHO"))
  49.    (setvar "CMDECHO" 0)
  50.  
  51.    (setq lname (strcase (getstring "\nLayer(s) to delete: ")))
  52.  
  53.    ;; Get all entities on layer(s)
  54.    (setq sset_1 (ssget "_X" (list (cons 8 lname))))
  55.  
  56.    (if sset_1
  57.       (progn
  58.          (initget "Yes No")
  59.          (setq prg (getkword "\nPrepare the layer(s) for purging <Y>/N:"))
  60.          (if (= prg nil) (setq prg "Yes"))
  61.          (setq num (sslength sset_1))
  62.  
  63.          (setq count 0)                      ;delete the entities
  64.          (repeat (sslength sset_1)
  65.             (entdel (ssname sset_1 count))
  66.             (setq count (1+ count))
  67.          )
  68.  
  69.          ;Check that everything is gone
  70.          (if
  71.             (ssget "_X" (list (cons 8 lname)))
  72.             ;And if anything is left
  73.             (progn
  74.               (setq tm (getvar "tilemode"))
  75.                 (if (= 1 tm)
  76.                   (setvar "tilemode" 0)
  77.                 )
  78.                 ;Go to paperspace
  79.                 (if (/= 1 (getvar "cvport"))
  80.                  (progn
  81.                   (princ "\nSwitching to paper space.")
  82.                   (command "_.pspace")
  83.                  )
  84.                 )
  85.                 ;And try again
  86.                 (setq sset_2 (ssget "_X" (list (cons 8 lname))))
  87.                 (setq count 0)
  88.                  (repeat (sslength sset_2)
  89.                    (entdel (ssname sset_2 count))
  90.                    (setq count (1+ count))
  91.                  )
  92.               (setvar "tilemode" tm)
  93.             )
  94.          )
  95.  
  96.          (if (= prg "Yes")
  97.            (progn
  98.              ; Prep the layer for purging
  99.              ; Turn off, thaw, and unlock layer(s)
  100.              (setq ex (getvar "expert"))
  101.              (setvar "expert" 5)
  102.              (command "_.layer" "_off" lname "_thaw" lname "")
  103.                (if (= 0 (getvar "tilemode"))
  104.                  (command "_.vplayer" "_vpvisdflt" lname "_thaw" "_reset"
  105.                  lname "_all" "")
  106.                )
  107.              (princ "\n")(princ num)(princ " entities on layer(s) ")
  108.              (princ lname)(princ " deleted.")(princ "\nLayer(s) ") (princ lname)
  109.              (princ " is thawed, turned off, and purgeable.")
  110.              (setvar "expert" ex)
  111.            )
  112.            (progn
  113.              (princ "\n")(princ num)(princ " entities on layer(s) ")
  114.              (princ lname)(princ " deleted.")
  115.            )
  116.          )
  117.       )
  118.  
  119.       (princ "Layer empty or not a valid layer name.")
  120.    )
  121.  
  122.    (setq sset_1 nil)                   ; Free selection-sets
  123.    (setq sset_2 nil)
  124.    (setvar "CMDECHO" ocmd)             ; Restore saved mode
  125.    (setq *error* olderr)               ; Restore old *error* handler
  126.    (princ)
  127. )
  128.  
  129.  
  130.